﻿Imports SwDocumentMgr
Imports SwDocumentMgr.SwDmDocumentType
Imports SwDocumentMgr.SwDmCustomInfoType

Imports SolidWorks.Interop.sldworks
Imports SolidWorks.Interop.swconst

Imports SolidWorks.Interop.swconst.swUserPreferenceToggle_e
Imports SolidWorks.Interop.swconst.swUserPreferenceIntegerValue_e
Imports SolidWorks.Interop.swconst.swUserPreferenceStringListValue_e
Imports SolidWorks.Interop.swconst.swUserPreferenceDoubleValue_e
Imports SolidWorks.Interop.swconst.swSaveAsVersion_e
Imports SolidWorks.Interop.swconst.swMessageBoxIcon_e
Imports SolidWorks.Interop.swconst.swMessageBoxBtn_e
Imports SolidWorks.Interop.swconst.swSaveAsOptions_e
Imports SolidWorks.Interop.swconst.swDocumentTypes_e

Imports System
Imports System.Diagnostics

Module SW2007


    '获取 指定自定义属性
    Public Function GetCustomProperty(ByVal FileFullName As String, ByVal CustomProperty_Name As String, ByVal Close As Boolean) As String
        On Error GoTo ErrorHandler

        Dim swClassfac As SwDMClassFactory
        Dim swDocMgr As SwDMApplication
        Dim swDoc As SwDMDocument5
        Dim nRetVal As Long
        Dim i As Single

        swClassfac = New SwDMClassFactory
        swDocMgr = swClassfac.GetApplication(LicnceKey)

        swDoc = swDocMgr.GetDocument(FileFullName, swDmDocumentDrawing, True, nRetVal)     ' Open the file as read
        Return swDoc.GetCustomProperty(CustomProperty_Name, swDmCustomInfoDate)

        swDoc.CloseDoc()  ' Close the document before exiting.

        swDoc = Nothing
        swDocMgr = Nothing
        swClassfac = Nothing

ErrorHandler:

        If Not swDoc Is Nothing Then
            swDoc.CloseDoc()
        End If
    End Function

    '获取 全部自定义属性
    Public Function GetCustomPropertys(ByVal SldDrwFile As SLDDRW_File, ByVal Close As Boolean) As SLDDRW_File
        On Error GoTo ErrorHandler
        'On Error Resume Next

        Dim swClassfac As SwDMClassFactory
        Dim swDocMgr As SwDMApplication
        Dim swDoc As SwDMDocument5
        Dim nRetVal As SwDmDocumentOpenError

        Dim i As Integer

        swClassfac = New SwDMClassFactory
        swDocMgr = swClassfac.GetApplication(LicnceKey)
        swDoc = swDocMgr.GetDocument(SldDrwFile.Slddrw_File_Name, swDmDocumentDrawing, True, nRetVal)

        SldDrwFile.Part_Name = GetOnlyname(SldDrwFile.Slddrw_File_Name)

        CustomPropertyNames = swDoc.GetCustomPropertyNames()

        SldDrwFile.CustomPropertyCount = UBound(CustomPropertyNames)

        ReDim SldDrwFile.CustomProperty(SldDrwFile.CustomPropertyCount)

        For i = 0 To SldDrwFile.CustomPropertyCount
            SldDrwFile.CustomProperty(i).Name = CustomPropertyNames(i)
            SldDrwFile.CustomProperty(i).Value = swDoc.GetCustomProperty(CustomPropertyNames(i), swDmCustomInfoText)
            SldDrwFile.CustomProperty(i).Evaluated = swDoc.GetCustomPropertyValues(CustomPropertyNames(i), swDmCustomInfoText, SldDrwFile.CustomProperty(i).LinkedTo)
        Next
Return SldDrwFile
        swDoc.CloseDoc()

        swDoc = Nothing
        swDocMgr = Nothing
        swClassfac = Nothing

ErrorHandler:
        If Not swDoc Is Nothing Then
            swDoc.CloseDoc()
        End If
    End Function

    '写单一属性数据
    Public Sub SetCustomProperty(ByVal FileFullName As String, ByVal CustomProperty_Name As String, _
                ByVal CustomProperty_Value As String, ByVal Close As Boolean)

        On Error GoTo ErrorHandler
        'On Error Resume Next

        Dim swClassfac As SwDMClassFactory
        Dim swDocMgr As SwDMApplication
        Dim swDoc As SwDMDocument5
        Dim nRetVal As Long

        swClassfac = New SwDMClassFactory
        swDocMgr = swClassfac.GetApplication(LicnceKey)

        swDoc = swDocMgr.GetDocument(FileFullName, swDmDocumentDrawing, False, nRetVal)    ' Open the file as read-write.

        swDoc.SetCustomProperty(CustomProperty_Name, CustomProperty_Value)

        swDoc.Save() ' Save the changes made to the custom properties.
        swDoc.CloseDoc()  ' Close the document before exiting.

        swDoc = Nothing
        swDocMgr = Nothing
        swClassfac = Nothing

ErrorHandler:
        If Not swDoc Is Nothing Then
            swDoc.CloseDoc()
        End If
    End Sub

    '写全属性数据
    Public Sub SetCustomPropertys(ByVal SldDrwFile As SLDDRW_File, ByVal Close As Boolean)

        On Error GoTo ErrorHandler
        'On Error Resume Next

        Dim swClassfac As SwDMClassFactory
        Dim swDocMgr As SwDMApplication
        Dim swDoc As SwDMDocument5
        Dim nRetVal As Long
        Dim i As Integer
        Dim j As Integer


        swClassfac = New SwDMClassFactory
        swDocMgr = swClassfac.GetApplication(LicnceKey)

        swDoc = swDocMgr.GetDocument(SldDrwFile.Slddrw_File_Name, swDmDocumentDrawing, False, nRetVal)    ' Open the file as read-write.

        Dim OrginCustomPropertyNames = swDoc.GetCustomPropertyNames

        For i = 0 To SldDrwFile.CustomPropertyCount
            
            '判断一个自定义属性名是否存在,返回 IsHere
            Dim IsHere As Boolean = False
            If OrginCustomPropertyNames Is Nothing = False Then
                For Each s In OrginCustomPropertyNames
                    If s = SldDrwFile.CustomProperty(i).Name Then
                        IsHere = True
                        Exit For
                    End If
                Next
            End If

            '根据 IsHere 值进入修改or新增
            If IsHere = True Then   '修改
                If SldDrwFile.CustomProperty(i).LinkedTo = "" Then
                    swDoc.SetCustomProperty(SldDrwFile.CustomProperty(i).Name, SldDrwFile.CustomProperty(i).Value)
                Else

                End If
            ElseIf IsHere = False Then    '新增
                swDoc.AddCustomProperty(SldDrwFile.CustomProperty(i).Name, swDmCustomInfoText, SldDrwFile.CustomProperty(i).Value)
            End If
        Next

        swDoc.Save() ' Save the changes made to the custom properties.
        swDoc.CloseDoc()  ' Close the document before exiting.

        swDoc = Nothing
        swDocMgr = Nothing
        swClassfac = Nothing

ErrorHandler:
        If Not swDoc Is Nothing Then
            swDoc.CloseDoc()
        End If
    End Sub

    '删除全自定义属性
    Public Sub DeleteCustomPropertys(ByVal FileFullName As String, ByVal Close As Boolean)
        On Error GoTo ErrorHandler
        'On Error Resume Next

        Dim swClassfac As SwDMClassFactory
        Dim swDocMgr As SwDMApplication
        Dim swDoc As SwDMDocument5
        Dim nRetVal As SwDmDocumentOpenError

        swClassfac = New SwDMClassFactory
        swDocMgr = swClassfac.GetApplication(LicnceKey)
        swDoc = swDocMgr.GetDocument(FileFullName, swDmDocumentDrawing, False, nRetVal)

        CustomPropertyNames = swDoc.GetCustomPropertyNames()

        For Each CustomProperty_Name In CustomPropertyNames
            swDoc.DeleteCustomProperty(CustomProperty_Name)
        Next

        swDoc.Save()
        swDoc.CloseDoc()

        swDoc = Nothing
        swDocMgr = Nothing
        swClassfac = Nothing

ErrorHandler:
        If Not swDoc Is Nothing Then
            swDoc.CloseDoc()
        End If
    End Sub

    '删除自定义属性
    Public Sub DeleteCustomProperty(ByVal FileFullName As String, ByVal CustomProperty_Name As String, ByVal Close As Boolean)
        On Error GoTo ErrorHandler

        Dim swClassfac As SwDMClassFactory
        Dim swDocMgr As SwDMApplication
        Dim swDoc As SwDMDocument5
        Dim nRetVal As Long
        Dim i As Single

        swClassfac = New SwDMClassFactory
        swDocMgr = swClassfac.GetApplication(LicnceKey)

        swDoc = swDocMgr.GetDocument(FileFullName, swDmDocumentDrawing, False, nRetVal)    ' Open the file as read-write.

        swDoc.DeleteCustomProperty(CustomProperty_Name)

        swDoc.Save() ' Save the changes made to the custom properties.
        swDoc.CloseDoc()  ' Close the document before exiting.

        swDoc = Nothing
        swDocMgr = Nothing
        swClassfac = Nothing

ErrorHandler:
        If Not swDoc Is Nothing Then
            swDoc.CloseDoc()
        End If
    End Sub

    '添加自定义属性
    Public Sub AddCustomProperty(ByVal FileFullName As String, ByVal CustomProperty_Name As String, _
                     ByVal CustomProperty_Value As String, ByVal Close As Boolean)
        On Error GoTo ErrorHandler

        Dim swClassfac As SwDMClassFactory
        Dim swDocMgr As SwDMApplication
        Dim swDoc As SwDMDocument5
        Dim nRetVal As Long
        Dim i As Single

        swClassfac = New SwDMClassFactory
        swDocMgr = swClassfac.GetApplication(LicnceKey)

        swDoc = swDocMgr.GetDocument(FileFullName, swDmDocumentDrawing, False, nRetVal)    ' Open the file as read-write.

        swDoc.AddCustomProperty(CustomProperty_Name, swDmCustomInfoText, CustomProperty_Value)

        swDoc.Save() ' Save the changes made to the custom properties.
        swDoc.CloseDoc()  ' Close the document before exiting.

        swDoc = Nothing
        swDocMgr = Nothing
        swClassfac = Nothing

ErrorHandler:
        If Not swDoc Is Nothing Then
            swDoc.CloseDoc()
        End If
    End Sub

    '另存为dwg
    Public Sub Save_as_Dwg(ByVal Svae_Folder As String, ByVal SldDrwFile As SLDDRW_File)

        On Error Resume Next

        Dim nErrors As Long
        Dim nWarnings As Long
        Dim nRetVal As Long
        Dim bShowMap As Boolean
        Dim bRet As Boolean

        Dim swClassfac As SwDMClassFactory
        Dim swDocMgr As SwDMApplication
        Dim swDoc As SwDMDocument

        Dim Drw_NO As String

        Dim swApp As SldWorks
        Dim swModel As ModelDoc2

        '指定文件夹
        If CAD_To = 0 Then
            SldDrwFile.Parent_Folder = My.Computer.FileSystem.GetFileInfo(SldDrwFile.Slddrw_File_Name).DirectoryName
        End If

        SldDrwFile.Part_Name = GetOnlyname(SldDrwFile.Slddrw_File_Name)

        Drw_NO = ""
        
        '是否前缀图号
        If CAD_Add_Part_NO = 1 Then

            swClassfac = New SwDMClassFactory
            swDocMgr = swClassfac.GetApplication(LicnceKey)

            swDoc = swDocMgr.GetDocument(SldDrwFile.Slddrw_File_Name, swDmDocumentDrawing, True, nRetVal)     ' Open the file as read
            Drw_NO = swDoc.GetCustomProperty(Part_Number, swDmCustomInfoDate)
            swDoc.CloseDoc()  ' Close the document before exiting.
        End If

        '替换一些非法使用字符
        Drw_NO = Replace(Drw_NO, "/", "-", , , CompareMethod.Text)
        Drw_NO = Replace(Drw_NO, "\", "-", , , CompareMethod.Text)
        Drw_NO = Replace(Drw_NO, "<", "-", , , CompareMethod.Text)
        Drw_NO = Replace(Drw_NO, ">", "-", , , CompareMethod.Text)
        Drw_NO = Replace(Drw_NO, ":", "-", , , CompareMethod.Text)
        Drw_NO = Replace(Drw_NO, "*", "-", , , CompareMethod.Text)
        Drw_NO = Replace(Drw_NO, "?", "-", , , CompareMethod.Text)
        Drw_NO = Replace(Drw_NO, "|", "-", , , CompareMethod.Text)

        If Drw_NO <> "" Then
            SldDrwFile.Dwg_File_Name = SldDrwFile.Parent_Folder & "\" & Drw_NO & " " & SldDrwFile.Part_Name & dwg
        Else
            SldDrwFile.Dwg_File_Name = SldDrwFile.Parent_Folder & "\" & SldDrwFile.Part_Name &  dwg
        End If

        Debug.Print(SldDrwFile.Dwg_File_Name)

        swApp = CreateObject("SldWorks.Application")
        swApp.Visible = False
        swApp.OpenDoc(SldDrwFile.Slddrw_File_Name, swDmDocumentDrawing)
        swModel = swApp.ActiveDoc

        ' Show current settings
        Debug.Print("DxfMapping             = " & swApp.GetUserPreferenceToggle(swUserPreferenceToggle_e.swDxfMapping))
        Debug.Print("DXFDontShowMap         = " & swApp.GetUserPreferenceToggle(swDXFDontShowMap))
        Debug.Print("DxfVersion             = " & swApp.GetUserPreferenceIntegerValue(swDxfVersion))
        Debug.Print("DxfOutputFonts         = " & swApp.GetUserPreferenceIntegerValue(swDxfOutputFonts))
        Debug.Print("DxfMappingFileIndex    = " & swApp.GetUserPreferenceIntegerValue(swDxfMappingFileIndex))
        Debug.Print("DxfOutputLineStyles    = " & swApp.GetUserPreferenceIntegerValue(swDxfOutputLineStyles))
        Debug.Print("DxfOutputNoScale       = " & swApp.GetUserPreferenceIntegerValue(swDxfOutputNoScale))
        Debug.Print("DxfMappingFiles        = " & swApp.GetUserPreferenceStringListValue(swDxfMappingFiles))
        Debug.Print("DxfOutputScaleFactor   = " & swApp.GetUserPreferenceDoubleValue(swDxfOutputScaleFactor))
        Debug.Print("")

        ' Turn off showing of map

        bShowMap = swApp.GetUserPreferenceToggle(swDXFDontShowMap)

        Debug.Print("bShowMap = " & bShowMap)

        swApp.SetUserPreferenceToggle(swDXFDontShowMap, False)

        bRet = swModel.SaveAs4(SldDrwFile.Dwg_File_Name, swSaveAsCurrentVersion, swSaveAsOptions_Silent, nErrors, nWarnings)

        If bRet = False Then
            nRetVal = swApp.SendMsgToUser2("另存文件错误!", swMbWarning, swMbOk)
        End If

        ' Restore old setting

        swApp.SetUserPreferenceToggle(swDXFDontShowMap, bShowMap)

        swApp.CloseDoc(SldDrwFile.Slddrw_File_Name)
        
    End Sub

    '另存为pdf文件
    Public Sub Save_as_Pdf(ByVal Svae_Folder As String, ByVal SldDrwFile As SLDDRW_File)
        On Error Resume Next

        Dim nRetVal As Long

        Dim swClassfac As SwDMClassFactory
        Dim swDocMgr As SwDMApplication
        Dim swDoc As SwDMDocument

        Dim Drw_NO As String

        Dim swApp As SldWorks
        Dim swModel As ModelDoc2
        
         '指定文件夹
        If CAD_To = 0 Then
            SldDrwFile.Parent_Folder = My.Computer.FileSystem.GetFileInfo(SldDrwFile.Slddrw_File_Name).DirectoryName
        End If

        SldDrwFile.Part_Name = GetOnlyname(SldDrwFile.Slddrw_File_Name)

        Drw_NO = ""

        '是否前缀图号
        If CAD_Add_Part_NO = 1 Then
            swClassfac = New SwDMClassFactory
            swDocMgr = swClassfac.GetApplication(LicnceKey)

            swDoc = swDocMgr.GetDocument(SldDrwFile.Slddrw_File_Name, swDmDocumentDrawing, True, nRetVal)     ' Open the file as read
            Drw_NO = swDoc.GetCustomProperty(Part_Number, swDmCustomInfoDate)
            swDoc.Save() ' Save the changes made to the custom properties.
            swDoc.CloseDoc()  ' Close the document before exiting.
        End If

        '替换一些非法使用字符
        Drw_NO = Replace(Drw_NO, "/", "-", , , CompareMethod.Text)
        Drw_NO = Replace(Drw_NO, "\", "-", , , CompareMethod.Text)
        Drw_NO = Replace(Drw_NO, "<", "-", , , CompareMethod.Text)
        Drw_NO = Replace(Drw_NO, ">", "-", , , CompareMethod.Text)
        Drw_NO = Replace(Drw_NO, ":", "-", , , CompareMethod.Text)
        Drw_NO = Replace(Drw_NO, "*", "-", , , CompareMethod.Text)
        Drw_NO = Replace(Drw_NO, "?", "-", , , CompareMethod.Text)
        Drw_NO = Replace(Drw_NO, "|", "-", , , CompareMethod.Text)

        If Drw_NO <> "" Then
            SldDrwFile.Dwg_File_Name = SldDrwFile.Parent_Folder & "\" & Drw_NO & " " & SldDrwFile.Part_Name & PDF
        Else
            SldDrwFile.Dwg_File_Name = SldDrwFile.Parent_Folder & "\" & SldDrwFile.Part_Name &  pdf 
        End If
        '    Do While (SLDDRW_File.Dwg_File_Name = 0)
        SldDrwFile.Dwg_File_Name = Replace(SldDrwFile.Dwg_File_Name, "/", "+", , , CompareMethod.Binary)
        '    Loop
        Debug.Print(SldDrwFile.Dwg_File_Name)

        swApp = CreateObject("SldWorks.Application")
        swApp.Visible = False
        swApp.OpenDoc(SldDrwFile.Slddrw_File_Name, swDmDocumentDrawing)
        swModel = swApp.ActiveDoc


        Debug.Print(swModel.Printer)
        Dim ps As PageSetup
        ps = swModel.PageSetup
        ps.Orientation = 2   ' 1=Portrait  '2 = Landscape
        Dim pageArray(3) As Long
        pageArray(0) = 1
        pageArray(1) = 1
        pageArray(2) = 3
        pageArray(3) = 3

        Dim vPageArray As Object
        vPageArray = pageArray
        Dim copies As Long
        copies = 1
        Dim collate As Boolean
        collate = True
        ' Print to default printer

        swModel.Extension.PrintOut2(vPageArray, copies, collate, "", "")
        Dim e As Long
        Dim w As Long

        ' Save to PDF
        swModel.SaveAs4(SldDrwFile.Dwg_File_Name, 0, 0, e, w)

        swApp.CloseDoc(SldDrwFile.Slddrw_File_Name)
        'swApp.CloseAllDocuments(True)
        'swApp.ExitApp()
        'swApp = Nothing

    End Sub


    '列举外部参考引用
    Public Function GetExternalReference(ByVal FileFullName As String) As Object
        On Error GoTo ErrorHandler

        Dim swClassfac As SwDMClassFactory
        Dim swDocMgr As SwDMApplication
        Dim swDoc As SwDMDocument5
        Dim swSearchOpt As SwDocumentMgr.SwDMSearchOption
        Dim nDocType As Long
        Dim nRetVal As Long
        Dim i As Single

        Dim vDependArr As Object

        ' Determine type of SolidWorks file based on file extension

        If InStr(LCase(FileFullName), "sldprt") > 0 Then
            nDocType = swDmDocumentPart
        ElseIf InStr(LCase(FileFullName), "sldasm") > 0 Then
            nDocType = swDmDocumentAssembly
        ElseIf InStr(LCase(FileFullName), "slddrw") > 0 Then
            nDocType = swDmDocumentDrawing
        Else
            ' Probably not a SolidWorks file
            nDocType = swDmDocumentUnknown
            ' So cannot open
            Return Nothing
            Exit Function
        End If

        swClassfac = New SwDMClassFactory
        swDocMgr = swClassfac.GetApplication(LicnceKey)
        swSearchOpt = swDocMgr.GetSearchOptionObject
        swDoc = swDocMgr.GetDocument(FileFullName, nDocType, False, nRetVal)

        Debug.Print("File = " & swDoc.FullName)

        vDependArr = swDoc.GetAllExternalReferences(swSearchOpt)
        If vDependArr Is Nothing Then
            Return Nothing
            Exit Function
        End If

        For Each vDepend In vDependArr
            Debug.Print("  " & vDepend)
        Next vDepend

        Return vDependArr
        swDoc.CloseDoc()  ' Close the document before exiting.

        swDoc = Nothing
        swDocMgr = Nothing
        swClassfac = Nothing

ErrorHandler:

        If Not swDoc Is Nothing Then
            swDoc.CloseDoc()
            Return Nothing
        End If
    End Function

End Module

